Résumé statistique et analyses uni et bi-variées de la base

Cette synthèse présente les résultats de l’analyse visuelle de 309 affiches conservées entre les fonds des Archives nationales de France à Paris et la bibliothèque du Trinity College à Dublin. Cette étude a pour objectif l’examen des caractéristiques techniques et des altérations des affiches observées afin de déterminer la possible corrélation entre typologie d’affiche, mode d’affichage et altérations en présence.

library(plotly) ## Pour faire des plots interactifs
library(knitr)

data_brute <- read.csv2("data_brute/data_brute_final.csv")
data_brute$Fonds[data_brute$Fonds == "Ellenberger (CP/78AJ/67)"] <- "Ellenberger"

n_doc_par_fonds <- data.frame(Fonds = unique(data_brute$Fonds),
                              nb_doc = tapply(data_brute$id.unique,
                                              data_brute$Fonds,
                                              FUN = length))

# encrassement
encrassement <- data_brute[, c("id.unique",
                                "Fonds",
                                "Encrassement")]

ss_encrassement <- encrassement[encrassement$Encrassement == "sans" , ]
avc_encrassement <- encrassement[encrassement$Encrassement %in% c("oui",
                                                                   "verso",
                                                                   "recto-verso",
                                                                   "recto") , ]

# depot
depot <- data_brute[, c("id.unique",
                        "Fonds",
                        "dépôt")]

ss_depot <- depot[depot$dépôt == "0" , ]
avc_depot <- depot[depot$dépôt == "oui" , ]


# taches
taches<- data_brute[, c("id.unique",
                        "Fonds",
                        "Taches")]

ss_tache <- taches[taches$Taches == "sans" , ]
avc_tache <- taches[taches$Taches == "oui" , ]


# aureoles
aureole <- data_brute[, c("id.unique",
                        "Fonds",
                        "auréole")]


ss_aureole <- aureole[aureole$auréole == "0" , ]
avc_aureole <- aureole[aureole$auréole == "oui" , ]

# trace de colle

trace_colle <- data_brute[, c("id.unique",
                              "Fonds",
                              "Traces.de.colle")]

ss_trace_colle <- trace_colle[trace_colle$Traces.de.colle == "sans" , ]
avc_trace_colle <- trace_colle[trace_colle$Traces.de.colle %in% c("recto-verso",
                                                                  "verso",
                                                                  "recto") , ]

lacunes <- data_brute[, c("id.unique",
                              "Fonds",
                              "Lacunes")]


# lacunes
ss_lacunes <- lacunes[lacunes$Lacunes == "sans" , ]
avc_lacunes <- lacunes[lacunes$Lacunes %in% c("oui",
                                              "comblées",
                                              "consolidées") , ]

# perforation
perforation <- data_brute[, c("id.unique",
                              "Fonds",
                              "Perforation")]

ss_perforation <- perforation[perforation$Perforation == "" , ]
avc_perforation <- perforation[perforation$Perforation == "oui" , ]

# déchirure

dechirure <- data_brute[, c("id.unique",
                              "Fonds",
                              "Déchirures")]



ss_dechirure <- dechirure[dechirure$Déchirures == "sans" , ]
avc_dechirure <- dechirure[dechirure$Déchirures == "oui" , ]

# plis
plis <- data_brute[, c("id.unique",
                              "Fonds",
                              "Présence.de.plis")]


ss_plis <- plis[plis$Présence.de.plis == "0" , ]
avc_plis <- plis[plis$Présence.de.plis == "oui" , ]

# gondolement
gondolement <- data_brute[, c("id.unique",
                              "Fonds",
                              "gondolements..affichage.")]


ss_gondolement <- gondolement[gondolement$gondolements..affichage. == "sans" , ]
avc_gondolement <- gondolement[gondolement$gondolements..affichage. == "oui" , ]

# delamination
delamination <- data_brute[, c("id.unique",
                              "Fonds",
                              "délamination")]

ss_delamination <- delamination[delamination$délamination == "sans" , ]
avc_delamination <- delamination[delamination$délamination == "oui" , ]

# coupure
coupure <- data_brute[, c("id.unique",
                              "Fonds",
                              "Coupure")]

ss_coupure <- coupure[coupure$Coupure == "0" , ]
avc_coupure <- coupure[coupure$Coupure == "oui" , ]

# abrasion
abrasion <- data_brute[, c("id.unique",
                              "Fonds",
                              "abrasion")]

ss_abrasion <- abrasion[abrasion$abrasion == "0" , ]
avc_abrasion <- abrasion[abrasion$abrasion == "oui" , ]


# migration d'encre
fuse <- data_brute[, c("id.unique",
                              "Fonds",
                              "média.qui.fuse")]

ss_fuse <- fuse[fuse$média.qui.fuse == "0" , ]
avc_fuse <- fuse[fuse$média.qui.fuse == "oui" , ]

1 Présentation de la base

1.1 Nombre de documents par fonds

plot_ly(n_doc_par_fonds,
        x = ~Fonds,
        y = ~nb_doc,
        color = ~Fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents par fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

1.2 Mode d’affichage

mode_affichage <- rbind(data_brute$Mode.d.affichage.1,
                        data_brute$Mode.d.affichage.2)

df_mode_affichage <- data.frame(table(mode_affichage))


affichees <- df_mode_affichage[df_mode_affichage$mode_affichage != 0 , ]

kable(affichees,
      col.names = c("Mode d'affichage", "Nombre de documents"))

	Mode d’affichage	Nombre de documents
2	colle	123
3	perforation	22
4	ruban adhésif	76

cat("Nombre total de documents affichés : " ,sum(affichees$Freq),"\n",
round((sum(affichees$Freq)*100)/nrow(data_brute),2), "% de la base")

Nombre total de documents affichés :  221 
 71.52 % de la base

1.3 Medias

1.3.1 Type de média

Média 1

Type de média	Fréquence
crayon	1
encre	6
encre d’imprimerie	156
encre de sérigraphie	91
encre manuscrite	19
marqueur	30
média manuscrit	3
peinture	2
sérigraphie	1

Média 2

Type de média	Fréquence
0	276
encre	1
encre d’imprimerie	12
encre de sérigraphie	2
encre manuscrite	9
marqueur	1
peinture	6
stylo	2

Média 3

Type de média	Fréquence
?	1
0	306
encre d’imprimerie	1
stylo	1

1.3.2 Couleur des medias

couleurs <- c("bleu", "jaune", "lie de vin", "marron", "noir", "orange",
              "rose", "rouge", "vert", "violet", "rouge fluo", "brun")

liste_df <- list()
nb_couleur <- c(7, 2, 2)

for (i in 1:3){
  # Sélection des colonnes pertinentes
  colonnes <- c(paste0("Type.de.média.", i),
                paste0("Couleur.", 1:nb_couleur[i], ".du.média.", i))
  
  temp_couleur_par_media <- data_brute[, colonnes]
  
  # On rassemble toutes les colonnes de couleur dans un seul vecteur
  couleurs_media <- unlist(temp_couleur_par_media[, -1])  # on exclut Type.de.média
  
  couleurs_media <- as.character(couleurs_media)

  # Filtrer les couleurs valides
  couleurs_filtrees <- couleurs_media[couleurs_media %in% couleurs]
  
  # Compter les fréquences
  temp_count <- as.data.frame(table(couleurs_filtrees))
  names(temp_count) <- c("couleur", "frequence")
  
  # Stocker dans la liste
  liste_df[[i]] <- temp_count
}

# Initialiser un tableau avec toutes les couleurs
result <- data.frame(couleur = couleurs)

# Ajouter les fréquences de chaque média
for (i in 1:3) {
  # Fusionner avec le tableau de référence
  result <- merge(result, liste_df[[i]], by = "couleur", all.x = TRUE, sort = FALSE)
  
  # Renommer la colonne de fréquence ajoutée
  names(result)[ncol(result)] <- paste0("frequence_media_", i)
}

# Remplacer les NA par 0 (pour les couleurs absentes)
result[is.na(result)] <- 0


kable(result)

couleur	frequence_media_1	frequence_media_2	frequence_media_3
bleu	74	5	1
noir	157	26	1
rouge	138	16	1
orange	8	1	0
jaune	10	1	0
marron	24	1	0
vert	46	1	0
rouge fluo	0	1	0
rose	14	1	0
lie de vin	5	0	0
brun	0	0	0
violet	5	0	0

1.4 Couleur de surface

couleur_surface <- data_brute$couleur.de.surface

table_couleur_surface <- table(couleur_surface)

kable(table_couleur_surface,
      col.names = c("Couleur de surface", "Nombre d'affiche"))

Couleur de surface	Nombre d’affiche
?	1
blanc	272
bleu	4
jaune	17
noir	2
orange	2
rose	4
rouge	2
vert	4
violet	1

1.5 Remplois

remplois <- data_brute[, c("id.unique",
                           "Fonds",
                           "affiche.issue.de.remploi")]

1.5.1 Remplois (total)

table_remplois <- data.frame(table(remplois$affiche.issue.de.remploi))

                             
kable(table_remplois,
      col.names = c("Type de remplois", "Nombre de documents"))

Type de remplois	Nombre de documents
affiche	6
calendrier	1
Cfdt magazine	2
formulaire	1
non	294
papier de calibrage	1
papier listing	2
papier millimétré	2

table_remplois <- table_remplois[table_remplois$Var1 != "non" , ]

plot_ly(data = table_remplois,
        x = ~Var1,
        y = ~Freq,
        color = ~Var1,
        type = "bar") %>% 
  layout(title = "Nombre d'affiche issue de remplois",
         xaxis = list(title = "Type de remplois"),
         yaxis = list(title = "Nombre de document"))

1.5.2 Remplois (par fonds)

5W

5W

Type de remplois	Nombre de documents
affiche	6
Cfdt magazine	2
non	111

Ellenberger

Ellenberger

Type de remplois	Nombre de documents
calendrier	1
formulaire	1
non	117
papier de calibrage	1
papier listing	2
papier millimétré	2

Institut Charles V

Institut Charles V

Type de remplois	Nombre de documents
non	53

Papyrus Case

Papyrus Case

Type de remplois	Nombre de documents
non	13

2 Altérations

2.1 Altérations physico-chimiques

Encrassement

table_ss_encrassement <- data.frame(fonds = unique(ss_encrassement$Fonds),
                                    n_doc = tapply(ss_encrassement$Fonds,
                                                        ss_encrassement$Fonds,
                                                        length))

table_avc_encrassement <- data.frame(fonds = unique(avc_encrassement$Fonds),
                                    n_doc = tapply(avc_encrassement$Fonds,
                                                        avc_encrassement$Fonds,
                                                        length))

plot_ly(table_ss_encrassement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans encrassement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_encrassement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec encrassement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_encrassement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_encrassement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans encrassement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_encrassement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_encrassement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec encrassement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Dépots

table_ss_depot <- data.frame(fonds = unique(ss_depot$Fonds),
                                    n_doc = tapply(ss_depot$Fonds,
                                                        ss_depot$Fonds,
                                                        length))

table_avc_depot <- data.frame(fonds = unique(avc_depot$Fonds),
                                    n_doc = tapply(avc_depot$Fonds,
                                                        avc_depot$Fonds,
                                                        length))

plot_ly(table_ss_depot,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans dépôt (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_depot,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec dépôt (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_depot,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_depot$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans dépôt sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_depot,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_depot$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec dépôt sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Taches

table_ss_tache <- data.frame(fonds = unique(ss_tache$Fonds),
                             n_doc = tapply(ss_tache$Fonds,
                                            ss_tache$Fonds,
                                            length))

table_avc_tache <- data.frame(fonds = unique(avc_tache$Fonds),
                              n_doc = tapply(avc_tache$Fonds,
                                             avc_tache$Fonds,
                                             length))

plot_ly(table_ss_tache,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans tache (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_tache,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec tache (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_tache,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_tache$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans tache sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_tache,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_tache$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec tache sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Auréoles

table_ss_aureole <- data.frame(fonds = unique(ss_aureole$Fonds),
                             n_doc = tapply(ss_aureole$Fonds,
                                            ss_aureole$Fonds,
                                            length))

table_avc_aureole <- data.frame(fonds = unique(avc_aureole$Fonds),
                              n_doc = tapply(avc_aureole$Fonds,
                                             avc_aureole$Fonds,
                                             length))

plot_ly(table_ss_aureole,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans auréole (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_aureole,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec auréole (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_aureole,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_aureole$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans auréole sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_aureole,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_aureole$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec auréole sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Trace de colle

table_ss_trace_colle <- data.frame(fonds = unique(ss_trace_colle$Fonds),
                             n_doc = tapply(ss_trace_colle$Fonds,
                                            ss_trace_colle$Fonds,
                                            length))

table_avc_trace_colle <- data.frame(fonds = unique(avc_trace_colle$Fonds),
                              n_doc = tapply(avc_trace_colle$Fonds,
                                             avc_trace_colle$Fonds,
                                             length))

plot_ly(table_ss_trace_colle,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans trace de colle (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_trace_colle,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec trace de colle (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_trace_colle,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_trace_colle$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans trace de colle sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_trace_colle,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_trace_colle$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec trace de colle sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.1.0.1 Croisement avec les autres types d’altérations

avc_plis_involontaires <- data_brute[data_brute$plis.volontaires...involontaires
                                     %in% c("involontaire",
                                            "volontaire + involontaire") , 
                                     c("id.unique",
                                       "Fonds",
                                       "plis.volontaires...involontaires")]

colle_alteration_a_croiser <- list(avc_depot,
                                   avc_tache,
                                   avc_aureole,
                                   avc_delamination,
                                   avc_gondolement,
                                   avc_lacunes,
                                   avc_dechirure,
                                   avc_plis_involontaires)

ss_trace_colle_nb_croisement <- list()
avc_trace_colle_nb_croisement <- list()

for (i in 1:length(colle_alteration_a_croiser)){

ss_trace_colle_nb_croisement[[i]] <- nrow(ss_trace_colle[ss_trace_colle$id.unique %in% colle_alteration_a_croiser[[i]]$id.unique , ])
  
avc_trace_colle_nb_croisement[[i]] <- nrow(avc_trace_colle[avc_trace_colle$id.unique %in% colle_alteration_a_croiser[[i]]$id.unique , ])
  
}

croisement_colle <- data.frame(sans_trace_colle = do.call("rbind",
                                                        ss_trace_colle_nb_croisement),
                               avec_trace_colle = do.call("rbind",
                                                         avc_trace_colle_nb_croisement)
                               )

row.names(croisement_colle) <- c("dépôt",
                                 "tache",
                                 "auréole",
                                 "délamination",
                                 "gondolement",
                                 "lacune",
                                 "déchirure",
                                 "plis involontaires")

kable(croisement_colle)

	sans_trace_colle	avec_trace_colle
dépôt	7	19
tache	16	8
auréole	13	15
délamination	44	37
gondolement	16	45
lacune	89	62
déchirure	132	78
plis involontaires	22	11

croisement_long <- reshape2::melt(as.matrix(croisement_colle))
colnames(croisement_long) <- c("Altération", "Trace de colle", "Nombre de documents")

plot_ly(data = croisement_long,
        x = ~`Trace de colle`,
        y = ~Altération,
        z = ~`Nombre de documents`,
        type = "heatmap",
        colors = colorRamp(c("white", "darkred"))) %>%
  layout(title = "Croisement entre les traces de colle et les autres altérations",
         xaxis = list(title = "Présence de trace de colle"),
         yaxis = list(title = "Altération"),
         margin = list(l = 100))

2.2 Mécanique

Lacunes

table_ss_lacunes <- data.frame(fonds = unique(ss_lacunes$Fonds),
                               n_doc = tapply(ss_lacunes$Fonds,
                                              ss_lacunes$Fonds,
                                              length))

table_avc_lacunes <- data.frame(fonds = unique(avc_lacunes$Fonds),
                                n_doc = tapply(avc_lacunes$Fonds,
                                               avc_lacunes$Fonds,
                                               length))

plot_ly(table_ss_lacunes,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans lacune (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

plot_ly(table_avc_lacunes,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec lacune (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_lacunes,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_lacunes$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans lacune sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

plot_ly(table_avc_lacunes,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_lacunes$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec lacune sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.2.0.1 Situation et type de lacunes

Dans le document

		oui
0	89	5
colle	90	33
perforation	20	0
ruban adhésif	70	2

Sur les coins

		oui
0	88	6
colle	90	33
perforation	14	6
ruban adhésif	43	29

Sur les bords

		oui
0	88	6
colle	72	51
perforation	18	2
ruban adhésif	60	12

Perforation

table_ss_perforation <- data.frame(fonds = unique(ss_perforation$Fonds),
                               n_doc = tapply(ss_perforation$Fonds,
                                              ss_perforation$Fonds,
                                              length))

table_avc_perforation <- data.frame(fonds = unique(avc_perforation$Fonds),
                                n_doc = tapply(avc_perforation$Fonds,
                                               avc_perforation$Fonds,
                                               length))

plot_ly(table_ss_perforation,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans perforation (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_perforation,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec perforation (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_perforation,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_perforation$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans perforation sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_perforation,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_perforation$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec perforation sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plis

table_ss_plis <- data.frame(fonds = unique(ss_plis$Fonds),
                               n_doc = tapply(ss_plis$Fonds,
                                              ss_plis$Fonds,
                                              length))

table_avc_plis <- data.frame(fonds = unique(avc_plis$Fonds),
                                n_doc = tapply(avc_plis$Fonds,
                                               avc_plis$Fonds,
                                               length))

plot_ly(table_ss_plis,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans plis (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_plis,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec plis (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_plis,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_plis$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans plis sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_plis,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_plis$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec plis sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.2.0.2 Situation et type de pli

Dans le document

		cassé	écrasé	froissé	tensions
0	82	1	2	9	0
colle	77	3	33	10	0
perforation	17	1	0	2	0
ruban adhésif	59	1	0	7	5

Sur les coins

		cassé	écrasé	froissé	réseau de plis
0	75	16	0	2	1
colle	105	16	1	1	0
perforation	15	5	0	0	0
ruban adhésif	57	13	0	2	0

Sur les bords

		cassé	écrasé	froissé	tensions
0	75	6	0	13	0
colle	108	7	3	5	0
perforation	17	2	0	1	0
ruban adhésif	58	8	0	5	1

Gondolement

table_ss_gondolement <- data.frame(fonds = unique(ss_gondolement$Fonds),
                               n_doc = tapply(ss_gondolement$Fonds,
                                              ss_gondolement$Fonds,
                                              length))

table_avc_gondolement <- data.frame(fonds = unique(avc_gondolement$Fonds),
                                n_doc = tapply(avc_gondolement$Fonds,
                                               avc_gondolement$Fonds,
                                               length))

plot_ly(table_ss_gondolement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans gondolement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_gondolement,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec gondolement (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_gondolement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_gondolement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans gondolement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_gondolement,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_gondolement$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec gondolement sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Délamination

table_ss_delamination <- data.frame(fonds = unique(ss_delamination$Fonds),
                               n_doc = tapply(ss_delamination$Fonds,
                                              ss_delamination$Fonds,
                                              length))

table_avc_delamination <- data.frame(fonds = unique(avc_delamination$Fonds),
                                n_doc = tapply(avc_delamination$Fonds,
                                               avc_delamination$Fonds,
                                               length))

plot_ly(table_ss_delamination,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans delamination (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_delamination,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec delamination (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documentss du fonds

plot_ly(table_ss_delamination,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_delamination$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans delamination sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_delamination,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_delamination$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec delamination sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Coupures

table_ss_coupure <- data.frame(fonds = unique(ss_coupure$Fonds),
                               n_doc = tapply(ss_coupure$Fonds,
                                              ss_coupure$Fonds,
                                              length))

table_avc_coupure <- data.frame(fonds = unique(avc_coupure$Fonds),
                                n_doc = tapply(avc_coupure$Fonds,
                                               avc_coupure$Fonds,
                                               length))

plot_ly(table_ss_coupure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans coupure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_coupure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec coupure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

# altération / Nombre de documents du fonds

plot_ly(table_ss_coupure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_coupure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans coupure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_coupure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_coupure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec coupure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Déchirures

table_ss_dechirure <- data.frame(fonds = unique(ss_dechirure$Fonds),
                               n_doc = tapply(ss_dechirure$Fonds,
                                              ss_dechirure$Fonds,
                                              length))

table_avc_dechirure <- data.frame(fonds = unique(avc_dechirure$Fonds),
                                n_doc = tapply(avc_dechirure$Fonds,
                                               avc_dechirure$Fonds,
                                               length))

plot_ly(table_ss_dechirure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans déchirure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_dechirure,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec déchirure (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

# altération / Nombre de documents du fonds

plot_ly(table_ss_dechirure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_dechirure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans déchirure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_dechirure,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_dechirure$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec déchirure sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

2.3 Etat du tracé

Abrasion

table_ss_abrasion <- data.frame(fonds = unique(ss_abrasion$Fonds),
                               n_doc = tapply(ss_abrasion$Fonds,
                                              ss_abrasion$Fonds,
                                              length))

table_avc_abrasion <- data.frame(fonds = unique(avc_abrasion$Fonds),
                                n_doc = tapply(avc_abrasion$Fonds,
                                               avc_abrasion$Fonds,
                                               length))

plot_ly(table_ss_abrasion,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans abrasion (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_abrasion,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec abrasion (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

# altération / Nombre de documentss du fonds

plot_ly(table_ss_abrasion,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_abrasion$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans abrasion sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_abrasion,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_abrasion$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec abrasion sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Migration d’encre

table_ss_fuse <- data.frame(fonds = unique(ss_fuse$Fonds),
                               n_doc = tapply(ss_fuse$Fonds,
                                              ss_fuse$Fonds,
                                              length))

table_avc_fuse <- data.frame(fonds = unique(avc_fuse$Fonds),
                                n_doc = tapply(avc_fuse$Fonds,
                                               avc_fuse$Fonds,
                                               length))

plot_ly(table_ss_fuse,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents sans migration d'encre (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

plot_ly(table_avc_fuse,
        x = ~fonds,
        y = ~n_doc,
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Nombre de documents avec migration d'encre (stock)",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Nombre de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

# altération / Nombre de documentss du fonds

plot_ly(table_ss_fuse,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% ss_fuse$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents sans migration d'encre sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

plot_ly(table_avc_fuse,
        x = ~fonds,
        y = ~n_doc / n_doc_par_fonds[n_doc_par_fonds$Fonds %in% avc_fuse$Fonds , "nb_doc"],
        color = ~fonds,
        type = "bar") %>% 
  layout(title = "Part de documents avec migration d'encre sur l'ensemble des affiches du fonds",
         xaxis = list(title = "Fonds"),
         yaxis = list(title = "Part de documents"))

Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

2.4 Altération selon le mode d’affichage

2.4.1 Mode d’affichage (Total)

### Table de fréquence mode d'affichage ~ altération (global)

mode_affichage_alteration <- data_brute[ , c("id.unique",
                                             "Mode.d.affichage.1",
                                             "Mode.d.affichage.2",
                                             "Fonds")]

mode_affichage <- unique(mode_affichage_alteration$Mode.d.affichage.1)

affichage_alteration_a_croiser <- list(avc_depot,
                                 avc_tache,
                                 avc_aureole,
                                 avc_delamination,
                                 avc_gondolement,
                                 avc_lacunes,
                                 avc_dechirure,
                                 avc_plis_involontaires)

test <- data.frame(table(data_brute$Fonds,
      data_brute$Traces.de.colle,
      data_brute$auréole))

croisement_mode_alteration <- list()

for (i_mode in mode_affichage){
  
    temp_mode <- c(mode_affichage_alteration[mode_affichage_alteration$Mode.d.affichage.1 == i_mode , "id.unique"],
                       mode_affichage_alteration[mode_affichage_alteration$Mode.d.affichage.2 == i_mode
                                  & mode_affichage_alteration$Mode.d.affichage.2 != "0" , "id.unique"]) 
  temp_croisement <- list()

  for (i in 1:length(affichage_alteration_a_croiser)){
  
  temp_croisement[[i]] <- sum(temp_mode %in% affichage_alteration_a_croiser[[i]]$id.unique)
    
  }
  croisement_mode_alteration <- cbind(croisement_mode_alteration,
                                      temp_croisement)
}

croisement_mode_alteration <- data.frame(croisement_mode_alteration)


row.names(croisement_mode_alteration) <- c("dépôt",
                                           "tache",
                                           "auréole",
                                           "délamination",
                                           "gondolement",
                                           "lacune",
                                           "déchirure",
                                           "plis involontaires")

colnames(croisement_mode_alteration) <- mode_affichage
colnames(croisement_mode_alteration)[colnames(croisement_mode_alteration) == 0] <- "sans affichage"

kable(croisement_mode_alteration)

	colle	sans affichage	ruban adhésif	perforation
dépôt	22	3	1	0
tache	9	14	0	1
auréole	26	0	1	1
délamination	61	6	14	0
gondolement	56	3	2	0
lacune	94	16	36	7
déchirure	109	36	53	16
plis involontaires	22	2	8	1

### Puis par fonds

2.4.2 Mode d’affichage par fonds

5W

Croisement pour le fonds: 5W

	colle	sans affichage	ruban adhésif	perforation
dépôt	10	3	0	0
tache	5	2	0	0
auréole	2	0	1	1
délamination	12	2	4	0
gondolement	33	2	2	0
lacune	28	8	16	5
déchirure	35	21	23	13
plis involontaires	1	0	0	0

Ellenberger

Croisement pour le fonds: Ellenberger

	colle	sans affichage	ruban adhésif	perforation
dépôt	3	0	0	0
tache	2	12	0	1
auréole	1	0	0	0
délamination	3	3	10	0
gondolement	1	0	0	0
lacune	7	7	19	2
déchirure	15	14	29	3
plis involontaires	0	1	8	1

Institut Charles V

Croisement pour le fonds: Institut Charles V

	colle	sans affichage	ruban adhésif	perforation
dépôt	8	0	1	0
tache	2	0	0	0
auréole	11	0	0	0
délamination	36	1	0	0
gondolement	21	1	0	0
lacune	47	1	1	0
déchirure	46	1	1	0
plis involontaires	20	1	0	0

Papyrus Case

Croisement pour le fonds: Papyrus Case

	colle	sans affichage	ruban adhésif	perforation
dépôt	1	0	0	0
tache	0	0	0	0
auréole	12	0	0	0
délamination	10	0	0	0
gondolement	1	0	0	0
lacune	12	0	0	0
déchirure	13	0	0	0
plis involontaires	1	0	0	0

2.5 Altération selon le type de média principal

media_alteration <- data_brute[ , c("Type.de.média.1",
                                  "qualification.de.la.perte.de.cohésion..adhésion")]
kable(t(table(media_alteration$Type.de.média.1,
      media_alteration$qualification.de.la.perte.de.cohésion..adhésion)))

	crayon	encre	encre d’imprimerie	encre de sérigraphie	encre manuscrite	marqueur	média manuscrit	peinture	sérigraphie
0	1	6	139	89	19	30	2	2	1
écaillage	0	0	12	0	0	0	0	0	0
écaillage, pulvérulence	0	0	1	1	0	0	0	0	0
perte	0	0	2	1	0	0	0	0	0
perte	0	0	1	0	0	0	0	0	0
perte liée aux délaminations	0	0	1	0	0	0	0	0	0
pulvérulence	0	0	0	0	0	0	1	0	0

sessionInfo()

R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26100)

Matrix products: default


locale:
[1] LC_COLLATE=French_France.utf8  LC_CTYPE=French_France.utf8   
[3] LC_MONETARY=French_France.utf8 LC_NUMERIC=C                  
[5] LC_TIME=French_France.utf8    

time zone: Europe/Paris
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] knitr_1.48    plotly_4.10.4 ggplot2_3.5.1

loaded via a namespace (and not attached):
 [1] gtable_0.3.5       jsonlite_1.8.9     dplyr_1.1.4        compiler_4.4.1    
 [5] Rcpp_1.0.13        tidyselect_1.2.1   stringr_1.5.1      tidyr_1.3.1       
 [9] scales_1.3.0       yaml_2.3.10        fastmap_1.2.0      plyr_1.8.9        
[13] R6_2.5.1           generics_0.1.3     htmlwidgets_1.6.4  tibble_3.2.1      
[17] munsell_0.5.1      pillar_1.9.0       RColorBrewer_1.1-3 rlang_1.1.4       
[21] utf8_1.2.4         stringi_1.8.4      xfun_0.47          lazyeval_0.2.2    
[25] viridisLite_0.4.2  cli_3.6.3          withr_3.0.2        magrittr_2.0.3    
[29] crosstalk_1.2.1    digest_0.6.37      grid_4.4.1         rstudioapi_0.16.0 
[33] lifecycle_1.0.4    vctrs_0.6.5        evaluate_1.0.3     glue_1.8.0        
[37] data.table_1.16.0  farver_2.1.2       fansi_1.0.6        colorspace_2.1-1  
[41] reshape2_1.4.4     rmarkdown_2.28     purrr_1.0.2        httr_1.4.7        
[45] tools_4.4.1        pkgconfig_2.0.3    htmltools_0.5.8.1